home *** CD-ROM | disk | FTP | other *** search
/ SPACE 1 / SPACE - Library 1 - Volume 1.iso / program / 363 / xlisp20 / xlisp_c / xlio.c < prev    next >
Text File  |  1990-02-03  |  3KB  |  157 lines
  1. /* xlio - xlisp i/o routines */
  2. /*    Copyright (c) 1985, by David Michael Betz
  3.     All Rights Reserved
  4.     Permission is granted for unrestricted non-commercial use    */
  5.  
  6. #include "xlisp.h"
  7.  
  8. #ifdef MEGAMAX
  9. overlay "io"
  10. #endif
  11.  
  12. /* external variables */
  13. extern int xlplevel;
  14. extern int xlfsize;
  15. extern NODE *xlstack;
  16. extern NODE *s_stdin;
  17. extern int xldebug;
  18. extern int prompt;
  19. extern char buf[];
  20.  
  21. /* xlgetc - get a character from a file or stream */
  22. int xlgetc(fptr)
  23.   NODE *fptr;
  24. {
  25.     NODE *lptr,*cptr;
  26.     FILE *fp;
  27.     int ch;
  28.  
  29.     /* check for input from nil */
  30.     if (fptr == NIL)
  31.     ch = EOF;
  32.  
  33.     /* otherwise, check for input from a stream */
  34.     else if (consp(fptr)) {
  35.     if ((lptr = car(fptr)) == NIL)
  36.         ch = EOF;
  37.     else {
  38.         if (!consp(lptr) ||
  39.         (cptr = car(lptr)) == NIL || !fixp(cptr))
  40.         xlfail("bad stream");
  41.         if (rplaca(fptr,cdr(lptr)) == NIL)
  42.         rplacd(fptr,NIL);
  43.         ch = cptr->n_int;
  44.     }
  45.     }
  46.  
  47.     /* otherwise, check for a buffered file character */
  48.     else if (ch = fptr->n_savech)
  49.     fptr->n_savech = 0;
  50.  
  51.     /* otherwise, get a new character */
  52.     else {
  53.  
  54.     /* get the file pointer */
  55.     fp = fptr->n_fp;
  56.  
  57.     /* prompt if necessary */
  58.     if (prompt && fp == stdin) {
  59.  
  60.         /* print the debug level */
  61.         if (xldebug)
  62.         { sprintf(buf,"%d:",xldebug); stdputstr(buf); }
  63.  
  64.         /* print the nesting level */
  65.         if (xlplevel > 0)
  66.         { sprintf(buf,"%d",xlplevel); stdputstr(buf); }
  67.  
  68.         /* print the prompt */
  69.         stdputstr("> ");
  70.         prompt = FALSE;
  71.     }
  72.  
  73.     /* get the character */
  74.     if (((ch = getc(fp)) == '\n' || ch == EOF) && fp == stdin)
  75.         prompt = TRUE;
  76.  
  77.     /* check for input abort */
  78.     if (fp == stdin && ch == '\007') {
  79.         putchar('\n');
  80.         xlabort("input aborted");
  81.     }
  82.     }
  83.  
  84.     /* return the character */
  85.     return (ch);
  86. }
  87.  
  88. /* xlpeek - peek at a character from a file or stream */
  89. int xlpeek(fptr)
  90.   NODE *fptr;
  91. {
  92.     NODE *lptr,*cptr;
  93.     int ch;
  94.  
  95.     /* check for input from nil */
  96.     if (fptr == NIL)
  97.     ch = EOF;
  98.  
  99.     /* otherwise, check for input from a stream */
  100.     else if (consp(fptr)) {
  101.     if ((lptr = car(fptr)) == NIL)
  102.         ch = EOF;
  103.     else {
  104.         if (!consp(lptr) ||
  105.         (cptr = car(lptr)) == NIL || !fixp(cptr))
  106.         xlfail("bad stream");
  107.         ch = cptr->n_int;
  108.     }
  109.     }
  110.  
  111.     /* otherwise, get the next file character and save it */
  112.     else
  113.     ch = fptr->n_savech = xlgetc(fptr);
  114.  
  115.     /* return the character */
  116.     return (ch);
  117. }
  118.  
  119. /* xlputc - put a character to a file or stream */
  120. xlputc(fptr,ch)
  121.   NODE *fptr; int ch;
  122. {
  123.     NODE *oldstk,lptr;
  124.  
  125.     /* count the character */
  126.     xlfsize++;
  127.  
  128.     /* check for output to nil */
  129.     if (fptr == NIL)
  130.     ;
  131.  
  132.     /* otherwise, check for output to a stream */
  133.     else if (consp(fptr)) {
  134.     oldstk = xlsave(&lptr,NULL);
  135.     lptr.n_ptr = newnode(LIST);
  136.     rplaca(lptr.n_ptr,cvfixnum((FIXNUM)ch));
  137.     if (cdr(fptr))
  138.         rplacd(cdr(fptr),lptr.n_ptr);
  139.     else
  140.         rplaca(fptr,lptr.n_ptr);
  141.     rplacd(fptr,lptr.n_ptr);
  142.     xlstack = oldstk;
  143.     }
  144.  
  145.     /* otherwise, output the character to a file */
  146.     else
  147.     putc(ch,fptr->n_fp);
  148. }
  149.  
  150. /* xlflush - flush the input buffer */
  151. int xlflush()
  152. {
  153.     if (!prompt)
  154.     while (xlgetc(getvalue(s_stdin)) != '\n')
  155.         ;
  156. }
  157. əəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəə